perm filename IO[2,BGB] blob
sn#035877 filedate 1973-04-09 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00030 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 INPUT OUTPUT & DISPLAY SUBROUTINES.
00007 00003 TVDSKI. TVDSKO.
00010 00004 TVXGP.
00013 00005 HALF TONE TABLE.
00015 00006 CREOUT.
00017 00007 CREIN.
00019 00008 RELLOC(BASE). MEMORY RELLOCATOR.
00021 00009 TVIN4. FOUR BIT TELEVISION INPUT.
00023 00010 TVIN6. SIX BIT TELEVSION INPUT.
00026 00011 TVCAMI. SELECT TV CAMERA.
00027 00012 XCART. CART CONTROL COMMANDS.
00029 00013 CART SPACE WAR JOB.
00031 00014 CAMERA. SELECT CAMERA.
00032 00015 III DISPLAY SUBROUTINES.
00033 00016 III DPY CONTINUED.
00034 00017 III DPY CONTINUED.
00036 00018 CROP.
00037 00019 AI(X,Y). AV(X,Y).
00040 00020 CLIP(X1,Y1,X2,Y2). 2D CLIPPER.
00043 00021 2D CLIPPER continued.
00045 00022 STADPY. STATUS DISPLAY.
00048 00023 DPYGRID.
00051 00024 DECDPY(NUM). BLKTYPE(BLK).
00053 00025 DPYBLK(BLK). DISPLAY CONTENTS OF A BLOCK.
00054 00026 DPYBLK CONTINUED.
00057 00027 DPYBLK CONTINUED.
00058 00028 DPYHIS. DISPLAY HISTOGRAM.
00061 00029 DPYGON(PGON). DISPLAY POLYGON.
00063 00030 DPYWED(EDGE). DPYFACE(FACE).
00065 ENDMK
⊗;
;INPUT OUTPUT & DISPLAY SUBROUTINES.
TITLE IO
$←←400000
EXTERN FLGWED,REMAIN,BLKCNT,FTVHIS,CTRL,META,FTVSIX
EXTERN VCUT,TVBUF,SEGTV,HISTO,AVAIL,OLD44,FILM,FLGBGB
EXTERN HEADER,HISTOG,CHR,FLGRAR,FLGKIN
EXTERN LOCKIN
NODSIZ←←7
INTERN QBLK,DEL,MAG,SX,SY
SUBR(GETFIL)------------------------------------------------------
BEGIN GETFIL;SETUP FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.
SETZM FILNAM↔SETZM EXTION↔SETZM EXTION+1↔SETZM PPPN
OUTSTR[ASCIZ/ FILE = /]
LAC 1,[POINT 6,FILNAM,-1]↔LACI 2,6
INCHWL↔CAIN 15↔GO[INCHWL↔POP2J]↔AOSA(P)
L: INCHWL↔CAIL"a"↔SUBI 40
CAIN"."↔GO[LAC 1,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
CAIN"["↔GO[LAC 1,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
CAIN","↔GO[LAC 1,[POINT 6,PPPN,17] ↔LACI 2,3↔GO L]
CAIN"]"↔GO L
CAIN 15↔GO EOL ;END OF THE LINE.
CAIN 12↔GO EOL
CAIG" "↔GO L ;IGNORE GARBAGE.
SOJL 2,L↔SUBI 40↔IDPB 1↔GO L
EOL: INCHWL
SKIPN 1,EXTION↔LAC 1,ARG2↔DAC 1,EXTION
SKIPN FLGBGB↔POP2J
;BGB'S DEFAULT PROJECT SPECIFICATION.
SKIPN 1,PPPN↔ LAC 1,ARG1↔DAC 1,PPPN
POP2J
BEND;12/10/72------------------------------------------------------
FILNAM: 0 ;FILE NAME.
EXTION: 0 ;EXTENSION.
0
PPPN: 0 ;PROJECT-PROGRAMMER.
;TVDSKI. TVDSKO.
SUBR(TVDSKI)------------------------------------------------------
BEGIN TVDSKI;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
CALL(SEGTV)
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
L1: CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])
GO[RELEASE 1,↔POP0J]
LOOKUP 1,FILNAM↔GO L1
IN 1,DUMARG↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
POP0J
DUMARG: IOWD 24400,HEADER↔0
BEND;12/14/72-----------------------------------------------------
SUBR(TVDSKO)------------------------------------------------------
BEGIN TVDSKO;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])↔POP0J
CALL(SEGTV)
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/ ENTER FAILED.
/]↔GO .+4]
OUT 1,DUMARG↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
POP0J
DUMARG: IOWD 24400,HEADER↔0
BEND;12/14/72-----------------------------------------------------
SUBR(PLOTO)-------------------------------------------------------
BEGIN PLOTO;DISPLAY BUFFER TO DISK FILE - BGB 10 DEC 1972.
CALL(GETFIL,[SIXBIT/PLT/],[0])↔POP0J
LAC 1,DPYBUF↔LACN(1)1↔SUBI 2
CDR 2,(1)↔SETZM 1(2)
MOVS↔LAPI -1(1)↔DAC DUMLST
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO .+4
OUT 1,DUMLST↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
POP0J
DUMLST: 0↔0
BEND;12/10/72------------------------------------------------------
;TVXGP.
SUBR(TVXGP)-------------------------------------------------------
BEGIN TVXGP; VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
;BGB - 19 JANUARY 1973.
;ONE TO SIXTEEN EXPANSION: 216*4=864 BY (288*4=1152 OR 32 WORDS)
;XGP BUFFER SIZE 28513 = 864 LINES * 33 WORDS PER LINE + 1.
ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
;EXPAND CORE FOR XGP BUFFER.
LAC 44↔DAC SAV44#↔ADDI =28513↔IORI 1777
CALLI 11↔GO L4↔CALL(SEGTV)
CDR 1,SAV44↔SETZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)
;PUT CONTROL WORD IN EACH ROW.
LAC[1B11+=192B23+=32]↔LAC 1,SAV44↔AOS 1↔LACI 2,=864
DAC(1)↔ADDI 1,=33↔SOJG 2,.-2↔SLACI 577000↔DAC(1)
LAC P1,[POINT 6,TVBUF,-1]
LAC P2,SAV44↔ADDI P2,2
LACI I,=216
L1: LACI J,=32
L2: SETZB 0,1↔SETZB 2,3
LACI K,=9
L3: ILDB Q,P1↔TRZ Q,3↔ROTC 0,4↔ROTC 2,4
IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)↔IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
SOJG K,L3
DAC 0,=00(P2)↔DAC 1,=33(P2)↔DAC 2,=66(P2)↔DAC 3,=99(P2)
AOS P2
SOJG J,L2
ADDI P2,=100
SOJG I,L1
DETSEG
;GRAB THE DEVICE.
INIT 1,17↔SIXBIT/XGP/↔0↔GO[OUTSTR[
ASCIZ/ CAN'T INIT XGP.
/]↔ POP0J]
LAC SAV44↔DAP DUMARG↔DAP DUMARG+1↔DAP DUMARG+2
OUT 1,DUMARG↔RELEASE 1,
LAC SAV44↔CALLI 11
L4: OUTSTR[ASCIZ/ NOT ENUF CORE FOR XGP BUFFER.
/]↔ CRLF↔POP0J
DUMARG: XWD -=28513,0
XWD -=28513,0
XWD -=28513,0↔0
;HALF TONE TABLE.
HTT:
00↔17↔17↔00 ; 2 LINES HORIZONTAL TOGETHER. 0
00↔17↔00↔17 ; 2 LINES HORIZONTAL 1
06↔06↔06↔06 ; 2 LINES VERTICAL TOGETHER 2
00↔07↔07↔07 ; 9 DOTS TOGETHER 3
11↔06↔06↔11 ; BOTH DIAGONAL 4
00↔17↔07↔00 ; 8 DOTS TOGETHER 5
00↔00↔07↔07 ; 6 DOTS TOGETHER 6
00↔06↔06↔00 ; 4 DOTS TOGETHER 7
17↔00↔00↔00 ; 1 LINE HORIZONTAL 10
10↔10↔10↔10 ; 1 LINE VERTICAL 11
10↔04↔02↔01 ; 1 LINE DIAGONAL 12
00↔07↔00↔00 ; 3 DOTS TOGETHER 13
00↔03↔00↔00 ; 2 DOTS TOGETHER 14
00↔01↔00↔40 ; 2 DOTS APART 15
00↔01↔00↔00 ; 1 DOT 16
00↔00↔00↔00 ; NOTHING. 17
BEND;1/19/73-------------------------------------------------------
;CREOUT.
SUBR(CREOUT)------------------------------------------------------
BEGIN CREOUT; CONTOUR,REGION,EDGE FILE FORMAT OUTPUT.
;BGB - 6 DECEMBER 1972.
SKIPN CTRL↔GO TVDSKO
CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
LACN FILM
CALL(RELLOC,0)
;SETUP DUMP OUT ARGUMENT IOWD.
LAC FILM↔SUB@AVAIL
LACM 1,0↔MOVSS
LAP OLD44↔DAC OUTARG
LAC@FILM↔DAC TMP#↔DAC 1,@FILM ;FILE SIZE IN WORDS.
;FILE OUTPUT RITUAL.
LAC@AVAIL↔SUB FILM↔DAC@AVAIL
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM
GO[OUTSTR[ASCIZ/ ENTER FAILED.
/]↔GO .+4]
OUT 1,OUTARG↔JFCL
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
SETZM FILNAM↔SETZ EXTION↔SETZM EXTION+1↔SETZM PPPN
CALL(RELLOC,FILM)
LAC TMP↔DAC@FILM
LAC@AVAIL↔ADD FILM↔DAC@AVAIL
POP0J
OUTARG: 0↔0
BEND;1/8/73-------------------------------------------------------
;CREIN.
SUBR(CREIN)-------------------------------------------------------
BEGIN CREIN; CONTOUR,REGION,EDGE FILE FORMAT INPUT.
;BGB - 28 JANURAY 1973.
SKIPN CTRL↔GO TVDSKI
CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
LOOKUP 1,FILNAM
SETZM QBLK
LAC PPPN↔LAP FILM↔SOS↔DAC INARG ;IOWD
MOVS PPPN↔MOVMS↔ADD FILM
IORI 1777↔CAMG 44↔GO L1
CALLI 11↔HALT
LAC 44↔AOS↔SUB FILM↔DIVI 7↔DAC 1,REMAINDER
L1: IN 1,INARG
RELEASE 1,
OUTSTR[ASCIZ" EOF.
"]↔ RELEASE 1,
SETZM FILNAM↔SETZM EXTION↔SETZM EXTION+1↔SETZM PPPN
CDR@AVAIL↔ADD FILM↔DAC@AVAIL↔SETZM@
DIP↔AOS↔LAC 1,44↔BLT(1) ;CLEAR EMPTY AREA.
CALL(RELLOC,FILM)
;RESET AVAIL LIST.
LAC 1,@AVAIL↔LAC 2,44
LIPI 1,NODSIZ(1)↔GO L6
L5: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
L6: CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
CALL(DPYIMG)
POP0J
INARG: 0↔0
BEND;1/28/73------------------------------------------------------
;RELLOC(BASE). MEMORY RELLOCATOR.
SUBR(RELLOC)BASE--------------------------------------------------
BEGIN RELLOC;RELOCATE ALL POINTERS - BGB - 6 DECEMBER 1972.
ACCUMULATORS{A,B,C,D}
DEFINE KAR(Q){CAR Q(A)↔SKIPE↔ADD B↔DIP Q(A)↔GO .+1}
DEFINE KDR(Q){CDR Q(A)↔SKIPE↔ADD B↔DAP Q(A)↔GO .+1}
LAC B,ARG1 ;BASE ADDRESS.
LAC A,FILM ;BLOCK POINTER.
L1: SKIPN(A)2↔GO[KDR 0↔GO L2] ;EMPTY BLOCK.
RELOC D,A↔TRNE D,400000↔LACI D,333333
TRNE D,200000↔GO[KAR 0]↔ TRNE D,100000↔GO[KDR 0]
TRNE D,20000 ↔GO[KAR 1]↔ TRNE D,10000 ↔GO[KDR 1]
TRNE D,2000 ↔GO[KAR 3]↔ TRNE D,1000 ↔GO[KDR 3]
TRNE D,200 ↔GO[KAR 4]↔ TRNE D,100 ↔GO[KDR 4]
TRNE D,20 ↔GO[KAR 5]↔ TRNE D,10 ↔GO[KDR 5]
TRNE D,2 ↔GO[KAR 6]↔ TRNE D,1 ↔GO[KDR 6]
L2: ADDI A,7+7↔CAML A,44↔POP1J
SUBI A,7
GO L1
LIT
BEND;12/20/72-----------------------------------------------------
;TVIN4. FOUR BIT TELEVISION INPUT.
SUBR(TVIN4)------------------------------------------------------
BEGIN TVIN4; FOUR BIT TELEVISION INPUT - BGB - 14 DEC 1972.
L0: INIT 17,17↔SIXBIT/TV/↔0
GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
SETZM TVERR↔INPUT 17,TVPTR↔RELEASE 17,
;REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
LAC 1,TVERR
TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
/]↔ TRNE 1,40 ↔OUTSTR[ASCIZ/TV DATA MISS.
/]↔ TRNE 1,20 ↔OUTSTR[ASCIZ/TV NON EX MEM.
/]↔ TRNE 1,100060↔JRST L0
CALLI 22↔DAC TVTIME#
CALLI 14↔DAC TVDATE#
LAC[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
SETZM FTVSIX↔SETOM FTVHIS
;CONVERT FROM GREY CODE TO GRAY CODE.
LAC 16,[XWD L,0]↔BLT 16,12
LAP TVPTR↔GO 4
L: POINT 4,0,-1↔ FROM←←0
POINT 6,TVBUF,-1↔ TO←←1
=62208 ↔ CNT←←2
0 ↔ BYT←←3
ILDB BYT,FROM ;4
LAC BYT,GRAY(BYT) ;3
LSH BYT,2 ;6
AOS HISTO(BYT) ;7
IDPB BYT,TO ;8
SOJG CNT,4 ;9
POP0J ;12
BEND;12/16/72-----------------------------------------------------
TVPTR: XWD -=6912,0
TVCLIP: 701002 ;BCLIP=7 TCLIP=0 CAM=1.
TVYXW: BYTE(9)50,34,40
TVERR: 0
GRAY: OCT 12,13,11,10,15,14,16,17,5,4,6,7,2,3,1,0
;TVIN6. SIX BIT TELEVSION INPUT.
SUBR(TVIN6)------------------------------------------------------
BEGIN TVIN6; SIX BIT TELEVISION INPUT - BGB - 14 DEC 1972.
L0: INIT 17,17↔SIXBIT/TV/↔0
GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
SETZM TVERR6#↔PUSH P,TVCLIP
LACI 76↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 76.
LAC TVPTR↔LIPI 440400↔DAC P1#
L1: SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
IORM TVERR6↔TRNE 100060↔GO L1
LACI 54↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 54.
LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P2#
L2: SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
IORM TVERR6↔TRNE 100060↔GO L2
LACI 32↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 32.
LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P3#
L3: SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
IORM TVERR6↔TRNE 100060↔GO L3
LACI 10↔DPB[POINT 6,TVCLIP,23] ;TAKE CLIPS 10.
LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P4#
L4: SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
IORM TVERR6↔TRNE 100060↔GO L4
POP P,TVCLIP↔RELEASE 17,
;REPORT ON THE ERROR BITS.
LAC 1,TVERR6
TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
/]↔ TRNE 1,40 ↔OUTSTR[ASCIZ/TV DATA MISS.
/]↔ TRNE 1,20 ↔OUTSTR[ASCIZ/TV NON EX MEM.
/]
CALLI 22↔DAC TVTIME#
CALLI 14↔DAC TVDATE#
LAC[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
SETOM FTVSIX↔SETOM FTVHIS↔AOS(P);SKIP !!
;CONVERT FROM GREY CODE TO GRAY CODE.
LAC[POINT 6,TVBUF,-1]↔DAC P5#
LAC[XWD L,3]↔BLT 16↔LACI =62208
GO 3
;SIX BIT AC-LOOP.
L: ILDB 1,P1↔LAC 2,GRAY(1)
ILDB 1,P2↔ADD 2,GRAY(1)
ILDB 1,P3↔ADD 2,GRAY(1)
ILDB 1,P4↔ADD 2,GRAY(1)
IDPB 2,P5↔AOS HISTO(2)
SOJG 0,3↔POP0J
BEND;12/16/72-----------------------------------------------------
;TVCAMI. SELECT TV CAMERA.
SUBR(TVCAMI)------------------------------------------------------
BEGIN TVCAMI;TELEVISION CAMERA INPUT - BGB - 14 DEC 1972.
CALL(LOCKIN)
LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
ADDI =6912↔SKIPE CTRL↔ADDI 3*=6912
CALLI 11↔GO[FATAL(NO CORE FOR TVTAKE.)]
CALL(SEGTV)
LAC[XWD TVBUF,TVBUF+1]
SETZM TVBUF↔BLT TVBUF+=10367
SKIPE CTRL↔CALL(TVIN6)↔CALL(TVIN4)
LAC TMP44↔CALLI 11↔JFCL
CRLF↔UNLOCK↔POP0J
BEND;12/16/72-----------------------------------------------------
;XCART. CART CONTROL COMMANDS.
SUBR(XCART)-------------------------------------------------------
BEGIN XCART
OPDEF RADIO[7702B11]
OPDEF HALTSW[043000636367]
LAC 2,CHR ;INITIAL COMMAND CHARACTER.
CAIN 2,"V"↔GO L0
SKIPE CTRL↔TRO 2,200↔SKIPA ;SHIT.
M0: INCHRW 2 ;WAIT FOR COMMAND CHARACTER.
SETZM CNT0↔SETZM CNT1 ;ZIP TIME OF ANY PREVIOUS COMMAND.
SETZM CTRL↔TRZE 2,200↔SETOM CTRL
DAC 2,CHR
SLACI 0,=20 ;ONE-THIRD OF A SECOND.
;DRIVE ONE MINUTE FORWARDS OR BACKWARDS.
CAIN 2,"F"↔GO[LAC 1,[XWD =3600,12]↔GO M1]
CAIN 2,"B"↔GO[LAC 1,[XWD =3600,12]↔LAPI 0,2↔GO M1]
SKIPE CTRL↔GO .+5
;STEERING 5 SECONDS LEFT OR RIGHT.
CAIN 2,"L"↔GO[LAC 1,[XWD =300,11]↔LAPI 1↔GO M1]
CAIN 2,"R"↔GO[LAC 1,[XWD =300,11]↔LAPI 0↔GO M1]
;CAMERA PAN 10 SECONDS LEFT OR RIGHT.
CAIN 2,"L"↔GO[LAC 1,[XWD =600,14]↔GO M1]
CAIN 2,"R"↔GO[LAC 1,[XWD =600,14]↔LAPI 0,4↔GO M1]
CAIN 2,"0"↔GO M0 ;HALT WITH SPACEWAR RUNNING.
CAIN 2," "↔GO M0 ;HALT WITH SPACEWAR RUNNING.
EX: SETZM FIREUP#↔HALTSW↔CRLF↔POP0J
M1: HLRZM 0,CNT0 ↔ DAPZ 0,WORD0
HLRZM 1,CNT1 ↔ DAPZ 1,WORD1
;FIREUP SPACE WAR MODULE.
SKIPE FIREUP↔GO M0↔SETOM FIREUP
LAC[XWD 200001,L4]↔CALLI $+3↔GO M0
;CART SPACE WAR JOB.
;FIRE UP SPACE WAR JOB.
L0: SETZM CNT0↔SETZM CNT1
LAC 1,[XWD 200001,L4]
CALLI 1,400003
OUTCHR["*"]↔LACI 7↔DAC WORD2
;OLDE DIAGONOSTIC TTY LISTEN LOOP.
L1: INCHRW↔CAIN "X"↔GO EX
CAIGE"0"↔GO L2
CAILE"8"↔GO L2
ANDI 7↔DAC WORD2↔GO L1
L2: CAIGE"A"↔GO L3
CAILE"H"↔ANDI 7
IORI 10↔DAC WORD2↔GO L1
L3: CAIN 15↔OUTCHR["*"]↔GO L1
; SPACE WAR OUTPUT TO RADIO TRANSMITTER.
L4: CONSZ 40↔CALLI 400024 ;MAKE SURE WE ARE ON THE PDP-6.
SKIPE 1,WORD3↔GO[
DATAO 500,WORD3↔CALLI 400024] ;ROTATE TURN TABLE.
SOSLE CNT0↔GO[LAC WORD0↔GO L5]↔SETZM CNT0
SOSLE CNT1↔GO[LAC WORD1↔GO L5]↔SETZM CNT1
LAC WORD2
L5: TRNE 8↔RADIO 400054; 1 SELECT ACTION RELAYS.
TRNN 8↔RADIO 620054; 0 SELECT DIRECTION RELAYS.
TRNE 1↔RADIO 440053; 1 STEERING MOTOR.
TRNN 1↔RADIO 620053; 0 ;
TRNE 2↔RADIO 410052; 1 DRIVE MOTOR.
TRNN 2↔RADIO 600052; 0 ;
TRNE 4↔RADIO 360051; 1 CAMERA PAN MOTOR.
TRNN 4↔RADIO 570051; 0;
RADIO 340050
RADIO 340055
CALLI 400024;EXIT SPACEWAR JOB.
DECLARE{WORD0,WORD1,WORD2,WORD3,CNT0,CNT1}
BEND;12/18/72-----------------------------------------------------
;CAMERA. SELECT CAMERA.
SUBR(CAMERA)------------------------------------------------------
BEGIN CAMERA
OUTSTR[ASCIZ/ CAMERA = /]
INCHRW
ANDI 3
LSH 9
IORI 700002
DAC TVCLIP
CRLF
POP0J
BEND;12/6/72------------------------------------------------------
;III DISPLAY SUBROUTINES.
;DISPLAY UUO CODES.
OPDEF DPYPOS [XWD 702100,0]
OPDEF DPYSIZ [XWD 702140,0]
OPDEF DPYCLR [XWD 701000,0]
OPDEF UPG [XWD 703000,0]
OPDEF GETLIN [TTYUUO 6,]
A←1↔B←2↔C←3
RV←←6
AVCO←←106
VIS←←0
EP←←20
INV←←40
SVS←←100
SV←←2
DPYBUF: DPYBU.
=2048↔1↔XWD 1,=2048
DPYBU.: BLOCK 4000
;SOURCE WINDOW.
SX: 0
SY: 0
SOX: 0
SOY: 0
;OBJECT WINDOW.
OX: 0
OY: 0
MAG: 3.4
DEL: 32.0
;PSEUDO BEAM POSITION.
XXX: 0
YYY: 0
DECLARE{XL,XH,YL,YH}
IGNORE: 0
DPYPTR: 0
BUFEND: 0
BUFHD: 0
0
;III DPY CONTINUED.
DPYBIG: LAC 1,ARG1
LACI 3,INV+RV ;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
DPB 1,[POINT 3,3,27]
PUSH P,(P) ;COPY PC.
GO LV2
DPYBRT: LAC 1,ARG1
LACI 3,INV+RV
DPB 1,[POINT 3,3,24]
PUSH P,(P) ;COPY PC.
GO LV2
AIVECT: SKIPA C,[INV+AVCO]
AVECT: LACI C,VIS+AVCO
LV: LAC 1,ARG2↔LAC 2,ARG1
SKIPGE IGNORE↔POP2J
LVC: DPB A,[POINT 11,C,10]
DPB B,[POINT 11,C,21]
LV2: AOS A,DPYPTR
DAC C,(A)
LV3: LIPI A,<(<POINT 7,0,35>)>
DAC A,DPYPTR
LACI A,(A)
CAML A,BUFEND
SETOM IGNORE
POP2J
;III DPY CONTINUED.
DPYSTR: LAC 3,ARG1
LIPI 3,440700
ILDB 3↔JUMPE POP1J.
CALL(DTYO,0)↔GO DPYSTR+2
DTYO: LAC 1,ARG1
IDPB A,DPYPTR
CDR A,DPYPTR
CAML A,BUFEND
SETOM IGNORE
POP1J
DPYCLR: SKIPL DPYFLG#
DPYCLR
SETZM BUFHD
POPJ P,
DPYOUT:
SKIPN 1,BUFHD↔GO .+6
LAC 2,DPYPTR↔DAC 2,-2(1)
LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
CDR B,DPYPTR
SUB B,BUFHD
ADDI B,1
DAC B,BUFHD+1
LAC 1,ARG1
DPB A,[POINT 4,.+3,12]↔IOR A,DPYFLG↔SKIPL A↔UPG BUFHD
POP1J
DPYSET: SETZM DPYFLG
LAC 1,ARG1
ADDI 1,2
DAC 1,BUFHD
CDR 2,-3(1) ;SIZE
ADDI 2,-3(1)
SUBI 2,1
SETZM IGNORE
DAC 2,BUFEND
CLR2: LAC A,BUFHD
LACI B,1
DAC B,1(A)
LACI B,2(A)
LIPI B,1(A)
BLT B,@BUFEND ;SET DPY BUFFER TO NULL CHARACTER WORDS
PUSH P,(P) ;COPY PC.
GO LV3
;CROP.
SUBR(CROP)--------------------------------------------------------
BEGIN CLIPIN
LAC 1,OX↔LAC MAG↔FMP SX↔FSB 1,0↔DAC 1,SOX
LAC 1,OY↔LAC MAG↔FMP SY↔FSB 1,0↔DAC 1,SOY
LAC 1,OX↔LAC MAG↔FMP[155.0]↔FSB 1,0
CAMG 1,[-510.0]↔LAC 1,[-510.0]↔DAC 1,XL
LAC 1,OX↔LAC MAG↔FMP[155.0]↔FAD 1,0
CAML 1,[ 510.0]↔LAC 1,[510.0]↔DAC 1,XH
LAC 1,OY↔LAC MAG↔FMP[115.0]↔FSB 1,0
CAMG 1,[-470.0]↔LAC 1,[-470.0]↔DAC 1,YL
LAC 1,OY↔LAC MAG↔FMP[115.0]↔FAD 1,0
CAML 1,[ 470.0]↔LAC 1,[470.0]↔DAC 1,YH
POP0J
BEND;12/20/72-----------------------------------------------------
;AI(X,Y). AV(X,Y).
SUBR(AI)----------------------------------------------------------
BEGIN AI
LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX
LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY
SETZM AIVFLG
POP2J
BEND;12/20/72-----------------------------------------------------
AIVFLG:0
SUBR(AV)----------------------------------------------------------
BEGIN AV
LAC XXX↔DAC X1
LAC YYY↔DAC Y1
LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX↔DAC X2
LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY↔DAC Y2
CALL(CLIP,X1,Y1,X2,Y2)
JUMPE 1,[SETZM AIVFLG↔POP2J]
CAIN 1,1↔GO[
SKIPN AIVFLG↔GO[
SETOM AIVFLG↔GO L1+1]↔GO L2]
L1: SETZM AIVFLG
FIXX 6,↔FIXX 7,↔CALL(AIVECT,6,7)
L2: FIXX 8,↔FIXX 9,↔CALL(AVECT,8,9)
POP2J
DECLARE{X1,Y1,X2,Y2}
BEND;12/20/72-----------------------------------------------------
;COLUMN INTO X-COORDINATE.
SUBR(GETXY)VERTEX-------------------------------------------------
BEGIN GETXY; GET DISPLAY COORDINATES FROM ROW-COL COORDINATES.
;RETURN VALUES IN STACK.
;COL∃MN INTO X-COORDINATE.
LAC 1,ARG1↔PUSH P,(P) ;COPY PC.
COL 0,1
SKIPN FLGKINK↔GO .+3↔ADDI 40↔ANDCMI 77 ;NO DEKINK.
SUBI =144*=64↔FSC 225↔DAC 0,ARG2 ;DPY X.
;ROW INTO Y-COORDINATE.
ROW 2,1
SKIPN FLGKINK↔GO .+3↔ADDI 2,40↔ANDCMI 2,77 ;NO DEKINK.
LACI =108*=64↔SUB 0,2↔FSC 225↔DAC 0,ARG1 ;DPY Y.
POP0J
BEND;1/4/73-------------------------------------------------------
;CLIP(X1,Y1,X2,Y2). 2D CLIPPER.
DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
SUBR(CLIP)--------------------------------------------------------
; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
BEGIN CLIP
ACCUMULATORS{X1,Y1,X2,Y2,PDL}
PTR←13
;PICK 'EM UP;
LAC X1,ARG4↔LAC Y1,ARG3
LAC X2,ARG2↔LAC Y2,ARG1
LACI PTR,PDL-1
;SET NSEW BITS.
SETZB 1
CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8; NORTH.
CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4; SOUTH.
CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2; EAST.
CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1; WEST.
;EASY OUTSIDER EDGE.
TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]
;EASY INSIDER VERTICES.
JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
CAMN PTR,[XWD 4,PDL+3]↔GO[LACI 1,1↔GO L+1]
;COMPUTE EDGE COEFFICIENTS.
LAC Y1↔FSBR Y2↔DAC AAA
LAC X2↔FSBR X1↔DAC BBB
LAC X2↔FMPR Y1↔MOVNM CCC
LAC X1↔FMPR Y2↔FADRM CCC
;PARTIAL PRODUCTS.
LAC AAA↔FMPR XH↔DAC AXH
LAC AAA↔FMPR XL↔DAC AXL
LAC BBB↔FMPR YH↔DAC BYH
LAC BBB↔FMPR YL↔DAC BYL
;CORNER Q'S.
SETOM FLGO↔SETZM FLGZ
LAC AXH↔FADR BYH↔FADR CCC↔DAC QNE↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYH↔FADR CCC↔DAC QNW↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYL↔FADR CCC↔DAC QSW↔ANDM FLGO↔IORM FLGZ
LAC AXH↔FADR BYL↔FADR CCC↔DAC QSE↔ANDM FLGO↔IORM FLGZ
;HARD OUTSIDER CASES.
SKIPGE FLGO↔GO OUTSIDE
SKIPL FLGZ↔GO OUTSIDE
;2D CLIPPER continued.
;NORTH BORDER CROSSING.
LAC QNE↔XOR QNW↔SKIPL↔GO L2
LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
LAC BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
LAC YH↔PUSH PTR,
DONE
;SOUTH BORDER CROSSING.
L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
LAC BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
LAC YL↔PUSH PTR,
DONE
;EAST BORDER CROSSING.
L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
LAC XH↔PUSH PTR,
LAC AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
DONE
;WEST BORDER CROSSING.
L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
LAC XL↔PUSH PTR,
LAC AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
DONE
;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
L5: OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
/]↔ GO OUTSIDER
;VISIBLE PORTION EXIT.
L: SETO 1,
POP4J
LIT
BEND;12/20/72-----------------------------------------------------
;STADPY. STATUS DISPLAY.
SUBR(STADPY)------------------------------------------------------
BEGIN STADPY; STATUS DISPLAY - BGB - 21 JAN 1973.
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
CALL(AIVECT,[=160],[=502])
CALL(DPYSTR,[[ASCIZ/NODES/]])
CALL(AIVECT,[=170],[=477])
LAC 1,@BLKCNT↔CALL(DECDPY)
CALL(AIVECT,[=240],[=502])
CALL(DPYSTR,[[ASCIZ/LEVEL/]])
CALL(AIVECT,[=250],[=477])
SETZ 10,↔LAC 1,FILM
SON 1,1↔JUMPE 1,.+5
SON 1,1↔JUMPE 1,.+3
CW 1,1↔NCNT 10,1↔CALL(OD)
CALL(DPYOUT,[10])
POP0J
BEND;1/21/73------------------------------------------------------
SUBR(DPYIMG)------------------------------------------------------
BEGIN DPYIMG; - DISPLAY 1ST IMAGE OF THE FILM - BGB - 4 DEC 1972.
CALL(STADPY)
CALL(DPYBLK)
CALL(DPYGRID)
;SQUARE FRAME.
CALL(DPYSET,DPYBUF)
CALL(AIVECT,[-=510],[-=470])
CALL(AVECT,[ =510],[-=470])
CALL(AVECT,[ =510],[ =470])
CALL(AVECT,[-=510],[ =470])
CALL(AVECT,[-=510],[-=470])
;LOOP THE LEVELS, LOOP THE POLYGONS.
LAC 1,FILM
MARK 1,FILBIT↔SON 1,1↔JUMPE 1,L2 ;FIRST IMAGE.
SKIPE FLGWED↔GO L3
;CONTOUR DISPLAYS.
SON 1,1↔DAC 1,LEV0#↔DAC 1,LEV1# ;FIRST LEVEL.
L0: LAC 1,LEV1↔CDR 1,(1)↔DAC 1,LEV1 ;CDR-LEVEL-RING.
SON 1,1↔JUMPE 1,L1A
DAC 1,PGN0#↔DAC 1,PGN1# ;FIRST POLYGON.
L1: LAC 1,PGN1↔CDR 1,(1)↔DAC 1,PGN1 ;CDR-POLY-RING.
CALL(DPYGON,1)
LAC 1,PGN1↔CAME 1,PGN0↔GO L1 ;POLY-RING-END.
L1A: LAC 1,LEV1↔CAME 1,LEV0↔GO L0 ;LEVEL-RING-END.
L2: CALL(DPYOUT,[0])
POP0J ;EXIT.
;WINGED EDGE DISPLAY.
L3: PED 1,1↔DAC 1,E0#↔SETOM OLDRC ;FIRST EDGE.
L4: CALL(DPYWED,1)
PED 1,1
CAME 1,E0↔GO L4
GO L2
BEND;1/4/73-------------------------------------------------------
;DPYGRID.
SUBR(DPYGRID)-----------------------------------------------------
BEGIN DPYGRID
CALL(DPYSET,DPYBUF)
LAC[50.0]↔CAML MAG↔GO L↔SKIPE FLGKINK↔GO L
SETZ 10,↔FSB 10,MAG↔CAML 10,XL↔GO .-2↔FAD 10,MAG
LAC 6,YL↔FIXX 6,↔LAC 7,YH↔FIXX 7,
VLINES: LAC 5,10↔FIXX 5,
CALL(AIVECT,5,6)↔CALL(AVECT,5,7)
FAD 10,MAG↔CAMGE 10,XH↔GO VLINES
SETZ 10,↔FSB 10,MAG↔CAML 10,YL↔GO .-2↔FAD 10,MAG
LAC 6,XL↔FIXX 6,↔LAC 7,XH↔FIXX 7,
HLINES: LAC 5,10↔FIXX 5,
CALL(AIVECT,6,5)↔CALL(AVECT,7,5)
FAD 10,MAG↔CAMGE 10,YH↔GO HLINES
L: CALL(DPYOUT,[3])
POP0J
BEND;12/14/72-----------------------------------------------------
SUBR(ID)----------------------------------------------------------
BEGIN ID;IDENT DISPLAY - BGB - 13 DEC 1972.
JUMPE 10,[
CALL(DPYSTR,[[ASCIZ/NIL /]])↔AOS(P)↔POP0J]
LACI 2,"U"
FOR @' Eε{VEFPLI}{
TESTZ 10,E'BIT↔LACI 2,"E"}
TESTZ 10,FILBIT↔LACI 2,"F"
CALL(DTYO,2)
LACI 7,6↔DIPZ 10,10
JFFO 10,.+1↔CAIL 11,3↔GO[
ROT 10,3↔SUBI 11,3↔SOJA 7,.-1]↔ZAP 10
L: ROT 10,3↔ADDI 10,60
CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
CALL(DTYO,[" "])
AOS(P)↔POP0J
BEND;12/13/72-----------------------------------------------------
SUBR(OD)----------------------------------------------------------
BEGIN OD;OCTAL HALF WORD DISPLAY - BGB - 13 DEC 1972.
JUMPE 10,[CALL(DPYSTR,[[ASCIZ/--- /]])↔POP0J]
LACI 7,6↔DIPZ 10,10↔SETO
L: ROT 10,3↔ADDI 10,60↔TRNE 10,17↔SETZ
JUMPN 0,.+3↔CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
CALL(DTYO,[" "])↔POP0J
BEND;12/13/72-----------------------------------------------------
;DECDPY(NUM). BLKTYPE(BLK).
SUBR(DECDPY)------------------------------------------------------
BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
L: JUMPGE 1,.+5
MOVM 2,1
CALL(DTYO,["-"])
LAC 1,2
IDIVI 1,12
PUSH P,2
SKIPE 1
PUSHJ P,L
POP P,1↔ADDI 1,60
CALL(DTYO,1)
POP0J
BEND;12/17/72-----------------------------------------------------
SUBR(BLKTYPE)BLK--------------------------------------------------
BEGIN BLKTYPE; CONVERT BLOCK TYPE FROM UNARY TO BINARY.
;BGB - 31 DECEMBER 1972.
LAC 1,ARG1
TYPE 1,1
ANDI 1,177
CAIL 1,020↔GO L
JUMPE 1,POP1J.
;CAIN 1,000↔LACI 1,0 ;EMPTY.
;CAIN 1,001↔LACI 1,1 ;VERTEX.
;CAIN 1,002↔LACI 1,2 ;EDGE.
CAIN 1,004↔LACI 1,3 ;FACE.
CAIN 1,010↔LACI 1,4 ;POLYGON.
POP1J↔L:CAIN 1,020↔LACI 1,5 ;LEVEL.
CAIN 1,040↔LACI 1,6 ;IMAGE.
CAIN 1,100↔LACI 1,7 ;FILM.
POP1J
BEND;12/31/72-----------------------------------------------------
;DPYBLK(BLK). DISPLAY CONTENTS OF A BLOCK.
SUBR(DPYBLK)------------------------------------------------------
BEGIN DPYBLK; DISPLAY CONTENTS OF A BLOCK - BGB - 13 DEC 1972.
YORG ←← -=280
CALL(DPYSET,DPYBUF)
SKIPN 15,QBLK↔GO L2
SETQ(16,{BLKTYPE,QBLK})
;DISPLAY BLOCK TYPE LABEL.
CALL(AIVECT,[=320],[YORG-0])
LAC[
[ASCIZ/EMPTY/] ↔ [ASCIZ/VERTEX/]
[ASCIZ/EDGE/] ↔ [ASCIZ/FACE/]
[ASCIZ/POLYGON/] ↔ [ASCIZ/LEVEL/]
[ASCIZ/IMAGE/] ↔ [ASCIZ/FILM/] ](16)
L0: CALL(DPYSTR,0)
L1: CALL(DTYO,["-"])↔LAC 10,15↔CALL(ID)↔JFCL
;DPYBLK CONTINUED.
;DISPLAY CONTENTS OF THE FIRST THREE WORDS OF THE NODE.
RELOC 14,15 ;GET RELLOCATION BITS.
TRNE 14,$↔LACI 14,333333 ;EDGE CHEAT.
CALL(AIVECT,[=280],[YORG-=40])
CALL(DPYSTR,{[[ASCIZ/,. 0 /]]})
CAR 10,0(15)↔TRNE 14,200000↔CALL(ID)↔CALL(OD)
CDR 10,0(15)↔TRNE 14,100000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG-=60])
CALL(DPYSTR,{[[ASCIZ/<> 1 /]]})
CAR 10,1(15)↔TRNE 14,20000↔CALL(ID)↔CALL(OD)
CDR 10,1(15)↔TRNE 14,10000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=80])
CALL(DPYSTR,{[[ASCIZ/ 2 /]]})
CAR 10,2(15)↔CALL(OD)
CDR 10,2(15)↔CALL(OD)
;DISPLAY CONTENTS OF THE LAST THREE WORDS OF THE NODE.
CALL(AIVECT,[=280],[YORG -=120])
CALL(DPYSTR,{[[ASCIZ/↓↑ 3 /]]})
CAR 10,3(15)↔TRNE 14,2000↔CALL(ID)↔CALL(OD)
CDR 10,3(15)↔TRNE 14,1000↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=140])
CALL(DPYSTR,{[[ASCIZ/≤≥ 4 /]]})
CAR 10,4(15)↔TRNE 14,200↔CALL(ID)↔CALL(OD)
CDR 10,4(15)↔TRNE 14,100↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=160])
CALL(DPYSTR,{[[ASCIZ/←→ 5 /]]})
CAR 10,5(15)↔TRNE 14,20↔CALL(ID)↔CALL(OD)
CDR 10,5(15)↔TRNE 14,10↔CALL(ID)↔CALL(OD)
CALL(AIVECT,[=280],[YORG -=180])
CALL(DPYSTR,{[[ASCIZ/⊂⊃ 6 /]]})
CAR 10,6(15)↔TRNE 14,2↔CALL(ID)↔CALL(OD)
CDR 10,6(15)↔TRNE 14,1↔CALL(ID)↔CALL(OD)
;DPYBLK CONTINUED.
;LIGHT UP THE QBLK WHEN IT IS A VERTEX OR A POLYGON.
; 0 = EMPTY. 4 = POLYGON.
; 1 = VERTEX. 5 = LEVEL.
; 2 = EDGE. 6 = IMAGE.
; 3 = FACE. 7 = FILM.
CAIN 16,2↔GO[
CALL(DPYBRT,[5])
SETOM OLDRC
CALL(DPYWED,15)
GO L2]
CAIN 16,4↔GO[CALL(DPYBRT,[5])↔CALL(DPYGON,15)↔GO L2]
CAIN 16,3↔GO[CALL(DPYBRT,[5])↔CALL(DPYFACE,15)↔GO L2]
CAIN 16,1↔GO[
CALL(DPYBRT,[5])
CALL(GETXY,15)↔CALL(AI)
CCW 1,15
CALL(GETXY,1)↔CALL(AV)
↔GO L2]
L2: CALL(DPYBRT,[2])
CALL(DPYOUT,[1])↔POP0J
BEND;1/25/73------------------------------------------------------
QBLK: 0
;DPYHIS. DISPLAY HISTOGRAM.
SUBR DPYHIS;------------------------------------------------------
BEGIN DPYHIS;(PGON) - DISPLAY HISTOGRAM - BGB - 8 DEC 1972.
X←←10 ↔ Y←←11 ↔ CNT←←14
CALL(HISTOG)
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[1])
;SCALE THE IMAGE TO ITS LARGEST COLUMN.
SETZ↔HRLZI 1,-77
CAMGE 0,HISTO(1)↔LAC HISTO(1)↔AOBJN 1,.-2
MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔DAC 1,SY#
;INITIALIZE HISTO LOOP.
SETZ CNT,
NIM X,=511↔NIM Y,-=404
CALL(AIVECT,X,Y)↔MOVNS X
CALL(AVECT,X,Y)
L1: SKIPN FTVSIX↔GO[TRNE CNT,3↔GO L2↔GO .+1]
LAC Y,HISTO(CNT)↔FSC Y,233↔FMP Y,SY↔FIXX Y,
SUBI Y,=400
L2: CALL(AVECT,X,Y)
TRNE CNT,3↔GO L3
;INTENSITY LEVEL NUMERAL.
NIM 0,-=440↔SUBI X,10↔CALL(AIVECT,X,0)
LAC CNT↔LSHC -3↔SKIPE↔IORI "0"↔IORI " "
LSH 4↔LSHC 3
IORI "0"↔ROT 0,-16↔IORI 1
AOS 1,DPYPTR↔DAC(1)
;PEC CENT AT THIS LEVEL NUMERAL.
NIM 0,-=465↔CALL(AIVECT,X,0)↔ADDI X,10
LAC HISTO+0(CNT)↔ADD HISTO+1(CNT)
ADD HISTO+2(CNT)↔ADD HISTO+3(CNT)
IMULI =1000↔IDIVI =62208↔ADDI 5↔IDIVI =10
JUMPE L4↔IDIVI =10
ROT 1,-4
SKIPE↔IORI "0"↔IORI " "
LSH 3↔LSHC 4↔IORI "0"↔LSH 16↔IORI " %"
LSH 8↔IORI 1↔AOS 1,DPYPTR↔DAC(1)
L4: CALL(AIVECT,X,Y)
;ADVANCE.
L3: ADDI X,20
CALL(AVECT,X,Y)
AOS CNT↔CAIE CNT,100↔GO L1
NIM -=400↔CALL(AVECT,X,0)
CALL(DPYOUT,[0])↔CRLF↔POP0J
BEND;12/16/72-----------------------------------------------------
;DPYGON(PGON). DISPLAY POLYGON.
SUBR(DPYGON)PGON--------------------------------------------------
BEGIN DPYGON; DISPLAY POLYGON - BGB - 4 DEC 1972.
;FIRST EDGE/VERTEX ABSOLUTE INVISIBLE VECTOR.
LAC 1,ARG1
ARC 2,1↔SKIPG FLGRAR↔SON 2,1
LAC 1,2
JUMPE 1,POP1J.
L0: DAC 1,E0#↔DAC 1,V#
CALL(GETXY,1)↔PUSHJ P,AI
;FOLLOW AROUND THE POLYGON WITH ABS VISIBLE VECTORS.
L1: LAC 1,V↔CDR 1,0(1)↔DAC 1,V
CALL(GETXY,1)↔LAC 1,V↔CNTRST 0,1↔MOVMS
CAMG 0,VCUT↔GO[PUSHJ P,AI↔GO .+2]↔PUSHJ P,AV
LAC 1,V↔EXO 2,1↔JUMPN 2,[
ENDO 0,2↔CAME 0,V↔GO .+1
CALL(GETXY,2)↔CALL(AV)
CALL(GETXY,V)↔CALL(AV)↔GO .+1]
LAC 1,V↔CAME 1,E0↔GO L1
;IS DISPLAY BOTH ENABLED.
SKIPL FLGRAR↔POP1J
LAC 1,ARG1↔ARC 1,1↔CAME 1,E0↔JUMPN 1,L0↔POP1J
BEND;1/25/73------------------------------------------------------
;DPYWED(EDGE). DPYFACE(FACE).
SUBR(DPYWED)EDGE--------------------------------------------------
BEGIN DPYWED; DISPLAY WINGED EDGE - BGB - 4 JAN 1973.
LAC 1,ARG1
PVT 2,1↔LAC RC(2)
CAMN OLDRC↔GO L1
DAC OLDRC
CALL(GETXY,2)↔CALL(AI)
L1: LAC 1,ARG1
NVT 2,1↔LAC RC(2)↔DAC OLDRC
CALL(GETXY,2)↔CALL(AV)
LAC 1,ARG1↔POP1J
BEND;1/4/73-------------------------------------------------------
OLDRC: -1
SUBR(DPYFACE)FACE-------------------------------------------------
POP1J
COMMENT ⊗
BEGIN DPYFACE; DISPLAY FACE - BGB - 4 JAN 1973.
EXTERN ECCW
LAC 1,ARG1↔DAC 1,FACE#
PED 1,1↔DAC 1,E0#↔SETOM OLDRC
L1: CALL(DPYWED,1)
CALL(ECCW,1,FACE)
CAME 1,E0↔GO L1
POP1J↔LIT↔VAR
BEND;1/4/73-------------------------------------------------------
⊗
END